home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
ARCVIEW.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-02
|
32KB
|
1,001 lines
UNIT ArcView;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Viser indhold af arkiv, samt bestemmer type Last changed: 02.03.97 SA ║}
{║ ║}
{║ (C) Copyright 1989-97 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, Dos, PoPTypes;
FUNCTION PackerExtension(Num: Byte): S3;
FUNCTION ArcType(CONST FNam: PathStr): ShortInt;
PROCEDURE ViewArchive(CONST FNam: PathStr; ArcType: ShortInt);
IMPLEMENTATION
USES OpCrt, OpString, OpWindow, OpKey,
Globals, StrUtil, OproUtil, Keyboard, Util, Display, Input, FileUtil;
CONST
SelfExtractingOffset : LongInt = 0;
FUNCTION PackerExtension(Num: Byte): S3;
VAR
s:S3;
BEGIN
CASE Num OF
0 : s:='???';
1 : s:='ARC';
2 : s:='ZIP';
3 : s:='LZH';
4 : s:='PAK';
5 : s:='ZOO';
6 : s:='SQZ';
7 : s:='ARJ';
ELSE s:='';
END;
PackerExtension:=s;
END;
FUNCTION ArcType(CONST FNam: PathStr): ShortInt;
TYPE
ExeHeaderRec = record
Signature : Word; {EXE file signature}
LengthRem : Word; {Number of bytes in last page of EXE image}
LengthPages : Word; {Number of 512 byte pages in EXE image}
NumReloc : Word; {Number of relocation items}
HeaderSize : Word; {Number of paragraphs in EXE header}
MinHeap : Word; {Minimum extra paragraphs to allow}
MaxHeap : Word; {Paragraphs to keep beyond end of image}
StackSeg : Word; {Initial stack seg relative to image base}
StackPtr : Word; {Initial SP}
CheckSum : Word; {EXE file check sum, not used}
IpInit : Word; {Initial IP}
CodeSeg : Word; {Initial code seg relative to image base}
RelocOfs : Word; {Bytes into EXE for first relocation item}
OverlayNum : Word; {Overlay number, not used here}
end;
VAR
test : Word;
f : FILE;
buf : ARRAY[1..10] OF Char;
x : ShortInt;
head : ExeHeaderRec ABSOLUTE Buf;
BEGIN
SelfExtractingOffset:=0;
x:=0;
Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
Reset(f,1);
test:=IOResult;
IF test=0 THEN
BEGIN
BlockRead(f,buf,10,test);
IF (buf[1]='H') AND (buf[2]='L') AND (buf[3]='S') AND (buf[4]='Q') AND (buf[5]='Z') THEN x:=6 ELSE
IF (buf[2]=#234) AND (buf[1]=#96) THEN x:=7 ELSE
IF (buf[1]='P') AND (buf[2]='K') THEN x:=2 ELSE
IF (buf[3]='-') AND (buf[4]='l') AND (buf[5]='h') AND (buf[6] IN ['0'..'9']) AND (buf[7]='-') THEN x:=3 ELSE
IF buf[1]=#26 THEN
BEGIN
{ ** CHECK OGSÅ FOR PAK ** }
IF buf[2] IN [#1..#9] THEN x:=1 ELSE x:=4;
END
ELSE
IF (buf[1]='Z') AND (buf[2]='O') AND (buf[3]='O') THEN x:=5 ELSE
IF (buf[1]='G') AND (buf[2]='I') AND (buf[3]='F') THEN x:=127;
IF x=0 THEN { CHECK SELFEXTRACTING }
BEGIN
IF Head.Signature=$5A4D THEN
BEGIN
SelfExtractingOffset:=LongInt(Head.LengthPages-1)*512+LongInt(Head.LengthRem);
Seek(f,SelfExtractingOffset);
BlockRead(f,buf,10,test);
IF (buf[1]='H') AND (buf[2]='L') AND (buf[3]='S') AND (buf[4]='Q') AND (buf[5]='Z') THEN x:=-6 ELSE
IF ((buf[2]=#234) AND (buf[1]=#96)) OR
((buf[4]=#234) AND (buf[3]=#96)) THEN
BEGIN
IF buf[4]=#234 THEN Inc(SelfExtractingOffset, 2);
x:=-7;
END ELSE
IF (buf[1]='P') AND (buf[2]='K') AND (buf[3]=#3) AND (buf[4]=#4) THEN x:=-2 ELSE
IF (buf[2]='P') AND (buf[3]='K') AND (buf[4]=#3) AND (buf[5]=#4) THEN
BEGIN
INC(SelfExtractingOffSet);
x:=-2;
END
ELSE
IF (buf[1]=#26) THEN
BEGIN
IF (buf[2] IN [#1..#9]) THEN x:=-1 ELSE x:=-4;
END
ELSE
IF (buf[3]='-') AND (buf[4]='l') AND (buf[5]='h') AND (buf[6] IN ['0'..'9']) AND (buf[7]='-') THEN x:=-3;
END;
END;
Close(f);
END;
ArcType:=x;
END;
PROCEDURE ViewArchive(CONST FNam: PathStr; ArcType: ShortInt);
TYPE
TotalArcType = RECORD
Files : Word;
OldSize,
size : LongInt;
END;
ArcFilePtr = ^ArcFileType;
ArcFileType = RECORD
FileName : S12;
OldSize,
NewSize : LONGINT;
DT : DateTime;
Typ : S20;
Mark : BOOLEAN;
Next : ArcFilePtr;
END;
VAR
Error : BOOLEAN;
Arc : ArcFilePtr;
ArcDT : DateTime;
TotalArc : TotalArcType;
Wait : PWait;
HelpWin,
ArcViewWin : windowptr;
PROCEDURE RegisterFile(CONST FileName: PathStr; OldSize, Size: LongInt; CONST Method: S10);
VAR
a,TmpArc:ArcFilePtr;
BEGIN
IF MaxAvail<5120 THEN
BEGIN
Error:=True;
END ELSE
BEGIN
New(a);
IF Arc=NIL THEN
BEGIN
Arc:=a;
END ELSE
BEGIN
TmpArc:=Arc;
WHILE TmpArc^.Next<>NIL DO
TmpArc:=TmpArc^.Next;
Tmparc^.Next:=a;
END;
Inc(TotalArc.Files);
Inc(TotalArc.size,size);
Inc(TotalArc.OldSize,OldSize);
a^.FileName:=Copy(JustFileName(FileName),1,12);
replace(a^.FileName,'/','\',0);
a^.OldSize:=OldSize;
a^.NewSize:=Size;
a^.dt:=ArcDT;
a^.typ:=Method;
a^.Mark:=False;
a^.Next:=NIL;
END;
END;
PROCEDURE ViewLZH(CONST FNam: PathStr; PacketOffset: LongInt; Wait: PWait);
TYPE
LZHHeaderType =RECORD
Headersize,{ No. bytes in header-2 (0=EOF) }
chksum : Byte;
typ : ARRAY[1..5] OF Char;
size_now,
orig_size : LongInt;
Time,
Date,
attrib : Word;
FileNameLength : Byte;
END;
VAR
OldFilePos : LongInt;
f : FILE;
LZHHead : LZHHeaderType;
test : Word;
PROCEDURE DoLZHHeader;
VAR
FileName : PathStr;
BEGIN
BlockRead(f,FileName[1],LZHHead.FileNameLength,test);
FileName[0]:=Chr(LZHHead.FileNameLength);
Seek(f,OldFilePos+LZHHead.size_now+LZHHead.HeaderSize+2);
UnPackTime(LongInt(LZHHead.Time)+(LongInt(LZHHead.Date) SHL 16),ArcDT);
RegisterFile(FileName,LZHHead.orig_size,LZHHead.size_now,LZHHead.typ);
END;
BEGIN
Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
Reset(f,1);
Seek(f,packetoffset);
WHILE NOT EOF(f) DO
BEGIN
OldFilePos:=FilePos(f);
BlockRead(f,LZHHead,SizeOf(LZHHead),test);
IF test=SizeOf(LZHHeaderType) THEN
IF (LZHHead.typ[1]='-') AND (LZHHead.typ[2]='l') AND
(LZHHead.typ[3]='h') AND (LZHHead.typ[5]='-') THEN DoLZHHeader ELSE Seek(f,FileSize(f));
IF Wait<>NIL THEN Wait^.Animate;
END;
Close(f);
END;
PROCEDURE ViewZIP(CONST FNam: PathStr; PacketOffset: LongInt; Wait: PWait);
TYPE
ZipMainHeader =RECORD
PK_ID,
HeadType : Word; { local=$0403,CENTRAL=$0201,LAST=$0605 }
END;
ZipLocalHeader=RECORD
extractversion,{ 1=IBM,2=AMIGA,4=VMS,8=UNIX }
gp_flags,{ 1=ENCRYPTED }
compression,
mod_time,
mod_date : Word;
Crc,
size_now,
real_size : LongInt;
name_length,
ExtraField : Word;
END;
{ Filename follows, no null terminator! }
{ Extra field, no null terminator. }
ZipCentralDirectory=RECORD
VersionMadeBy,
VersionNeeded,
gp_flags,
Method,
LastTime,
LastDate : Word;
Crc32,
SizeNow,
NormalSize : LongInt;
FileNameLength,
ExtraField,
FileCmntLength,
DiskNumStart,
IntFAttr : Word;
ExtFAttr,
LocalOffset : LongInt;
END;
{
filename (variable size)
extra field (variable size)
file comment (variable size)
}
ZipCentralEnd =RECORD
NumDisks,
StartDisk,
TotalEntryDisk,
TotalEntryDir,
DirSize : Word;
offset : LongInt;
CmntLength : Word;
END;
{ zipfile comment (variable size) }
VAR
f : FILE;
First : ZipMainHeader;
test : Word;
FUNCTION ZIPType(n: Byte): S10;
BEGIN
CASE n OF
0 : ZIPType:='Stored';
1 : ZIPType:='Shrunk';
2..5 : ZIPType:='Reduced '+CHR(47+n);
6 : ZIPType:='Imploded';
7 : ZIPType:='Tokenized';
8 : ZIPType:='Inflated';
ELSE ZIPType:='Unknown';
END;
END;
PROCEDURE DoLocalHeader;
VAR
Local : ZipLocalHeader;
FNam : PathStr;
BEGIN
BlockRead(f,Local,SizeOf(Local),test);
BlockRead(f,FNam[1],Local.name_length,test);
FNam[0]:=Chr(Local.name_length);
Seek(f,FilePos(f)+Local.size_now+Local.ExtraField);
UnPackTime(LongInt(Local.mod_time) + (LongInt(Local.mod_date) SHL 16),ArcDT);
RegisterFile(FNam,Local.real_size,Local.size_now,ZIPType(Local.compression));
END;
PROCEDURE DoCentralEndHeader;
VAR
CentralEnd : ZipCentralEnd;
BEGIN
BlockRead(f,CentralEnd,SizeOf(CentralEnd),test);
Seek(f,FilePos(f)+CentralEnd.CmntLength);
END;
PROCEDURE DoCentralDirHeader;
VAR
CentralDir : ZipCentralDirectory;
BEGIN
BlockRead(f,CentralDir,SizeOf(CentralDir),test);
{ BlockRead(f,FNam[1],CentralDir.FileNameLength,test);
FNam[0]:=Chr(CentralDir.FileNameLength);}
Seek(f,FilePos(f)+CentralDir.FileNameLength+CentralDir.FileCmntLength+CentralDir.ExtraField);
END;
BEGIN
Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
Reset(f,1);
Seek(f,packetoffset);
REPEAT
BlockRead(f,First,SizeOf(First),test);
CASE First.HeadType OF
$0403 : DoLocalHeader;
$0201 : DoCentralDirHeader;
$0605 : DoCentralEndHeader;
END;
IF Wait<>NIL THEN Wait^.Animate;
UNTIL (First.HeadType=$0605) OR EOF(f);
Close(f);
END;
PROCEDURE ViewARC(CONST FNam: PathStr; PacketOffset: LongInt; Wait: PWait); { OGSÅ brugt til PAK!!!!! }
TYPE
ARCHeaderType =RECORD
Marker,
version : Byte;
FileName : ARRAY[1..13] OF Char;
size_now : LongInt;
Date, { packed date. bits 0-4 =day 5-8=month 9-15=year-1980 }
Time, { packed time. bits 0-4 =second / 2 5-10=minute 11-15=hour }
Crc : Word;
orig_size : LongInt;
END;
VAR
ARCHead : ARCHeaderType;
f : FILE;
test : Word;
FUNCTION ArcType(n: Byte): S10;
BEGIN
CASE n OF
1..2 : ArcType:='Stored';
3 : ArcType:='Packed';
4 : ArcType:='Squeezed';
5..8 : ArcType:='Crunched';
9 : ArcType:='Squashed';
10 : ArcType:='Crushed';
11 : ArcType:='Destilled';
ELSE ArcType:='Unknown';
END;
END;
PROCEDURE DoARCHeader;
VAR
FileName : S13;
BEGIN
BlockRead(f,ARCHead,SizeOf(ARCHead),test);
IF ARCHead.version<>0 THEN
BEGIN
Move(ARCHead.FileName,FileName[1],13);
FileName[0]:=#13;
FileName[0]:=Chr(pos(#0,FileName)-1);
UnPackTime(LongInt(ARCHead.Time) + (LongInt(ARCHead.Date) SHL 16),ArcDT);
RegisterFile(FileName,ARCHead.orig_size,ARCHead.size_now,ArcType(ARCHead.version));
IF ARCHead.version<>1 THEN Seek(f,FilePos(f)+ARCHead.size_now) ELSE
Seek(f,FilePos(f)+ARCHead.size_now-4);
END;
IF Wait<>NIL THEN Wait^.Animate;
END;
BEGIN
Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
Reset(f,1);
Seek(f,packetoffset);
ARCHead.version:=255;
WHILE (ARCHead.version<>0) DO
DoARCHeader;
Close(f);
END;
PROCEDURE ViewARJ(CONST FNam: PathStr; PacketOffset: LongInt; Wait: PWait);
Type
Arj1Header = Record
ID, { $EA60 / "`Ω"}
HSize : Word; { Size of basic header }
End;
Arj2Header = Record
First_hdr_size, { Size of header }
ArjVersion, { }
MinVersion, { }
OS, { MSDOS, PRIMOS, UNIX, AMIGA, MACDOS }
ArjFlags, { }
ArjMethod, { }
FileType, { }
Reserved : Byte; { }
Time, { }
IsSize, { }
WasSize, { }
OriginalCRC : LongInt;
AccessMode,
NamePos,
HostData : Word;
{ rest is variable size }
End;
Var
Skipped : BOOLEAN;
h1 : Arj1Header;
Buffer : Array[0..4095] Of Byte;
h2 : Arj2Header Absolute Buffer;
BasicCrc : LongInt;
f : File;
Hdr2Size,
i, k : Word;
FileName : PathStr;
FUNCTION ARJType(n: Byte): S10;
BEGIN
CASE n OF
0 : ARJType:='Stored';
1..4 : ARJType:='Mode '+CHR(48+n);
ELSE ARJType:='Unknown';
END;
END;
Begin
Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
Reset(f,1); Seek(f,PacketOffset);
Skipped:=False;
Repeat
BlockRead(f,h1,SizeOf(h1),k);
If h1.HSize<>0 Then
Begin
BlockRead(f, Buffer, h1.HSize, k);
UnPackTime(h2.Time, ArcDT);
i := h2.First_hdr_size;
FileName:='';
While (Buffer[i]<>0) And (i<=h1.HSize) Do
Begin
FileName:=FileName+Char(Buffer[i]);
Inc(i);
End;
If Buffer[i] <> 0 Then { double nul <=> no comment }
Begin
While (Buffer[i] <> 0) And (i <= h1.HSize) Do
Inc(i);
End;
{ skip secondary headers }
BlockRead(f, BasicCrc, 4, k); { Hdr CRC }
Repeat
BlockRead(f, Hdr2Size, 2, k);
Seek(f, FilePos(f) + Hdr2Size);
IF Hdr2Size<>0 THEN BlockRead(f, BasicCrc, 4, k); { Hdr CRC }
Until Hdr2Size = 0;
IF Skipped THEN
BEGIN
Seek(f, FilePos(f)+h2.IsSize);
RegisterFile(FileName,h2.WasSize,h2.IsSize,ARJType(h2.ARJMethod))
END ELSE
Skipped:=True;
End;
IF Wait<>NIL THEN Wait^.Animate;
Until (h1.HSize = 0) Or EoF(f);
Close(f);
End;
PROCEDURE ViewSQZ(CONST FNam: PathStr; PacketOffset: LongInt; Wait: PWait);
Type
SqzHeader = Record
ID : ARRAY[1..5] OF CHAR; { Always 'HLSQZ' }
Version : CHAR;
OS : BYTE;
Flag : BYTE;
End;
SqzFileHeader = Record
HdrSize,
HdrSum,
Method : BYTE;
Compressed,
Original,
FileDate : LONGINT;
Attrib : BYTE;
FileCrc : LONGINT;
End;
{ File name is HdrSize-18 chars after this }
Var
ah : SqzHeader;
fh : SqzFileHeader;
f : File;
FileName : PathStr;
tl : LONGINT;
NumRead : INTEGER;
w : WORD;
FUNCTION SQZType(n: BYTE):S10;
BEGIN
CASE n OF
0 : SQZType:='Stored';
1..4 : SQZType:='Method '+Long2Str(n);
ELSE SQZType:='Unknown';
END;
END;
Begin
Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
Reset(f,1); Seek(f,PacketOffset);
BlockRead(f,ah,SizeOf(SqzHeader));
REPEAT
BlockRead(f,fh.HdrSize,1,NumRead);
IF NumRead<1 THEN Break;
CASE fh.HdrSize OF
0 : Break; { End of archive }
1 : BEGIN { Comment }
BlockRead(f,w,2,NumRead);
IF NumRead<2 THEN Break;
BlockRead(f,w,2,NumRead);
IF NumRead<2 THEN Break;
Seek(f,FILEPOS(f)+w+5);
IF IOResult<>0 THEN Break;
END;
2 : BEGIN { Password }
Seek(f,FILEPOS(f)+6);
IF IOResult<>0 THEN Break;
END;
3 : BEGIN { Security envelope }
END;
4..18 : BEGIN { Skip everything but file headers }
BlockRead(f,w,2,NumRead);
IF NumRead<2 THEN Break;
Seek(f,FILEPOS(f)+w);
IF IOResult<>0 THEN Break;
END;
ELSE
BEGIN
BlockRead(f,fh.HdrSum,SizeOf(SqzFileHeader)-1,NumRead);
IF NumRead<SizeOf(SqzFileHeader)-1 THEN Break;
FileName[0]:=CHAR(fh.HdrSize-18);
BlockRead(f,FileName[1],fh.HdrSize-18,NumRead);
IF ah.Flag AND 2<>0 THEN tl:=fh.FileDate ELSE tl:=0;
UnpackTime(tl,ArcDT);
RegisterFile(FileName,fh.Original,fh.Compressed,SQZType(fh.Method));
Seek(f,FILEPOS(f)+fh.Compressed);
IF IOResult<>0 THEN Break;
END;
END;
IF Wait<>NIL THEN Wait^.Animate;
UNTIL EOF(f);
Close(f);
End;
PROCEDURE DisplayGIFInfo(CONST FNam: PathStr);
VAR
s : S10;
Colors,i,
BitsPerPixel : Integer;
Temp : windowptr;
f : FILE;
buf : RECORD
signature,
giftype : ARRAY[1..3] OF Char;
horizontal,
Vertical : Integer;
colorsflag : Byte;
END;
BEGIN
MyWin(Temp,25,6,55,14,3,'Info for GIF "'+JustFileName(FNam)+'"',True);
Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
Reset(f,1);
BlockRead(f,buf,SizeOf(buf),i);
Close(f);
BitsPerPixel:=buf.colorsflag AND 7+1;
IF BitsPerPixel=1 THEN Colors:=2 ELSE Colors:=1 SHL BitsPerPixel;
WITH Temp^ DO
BEGIN
wfasttext('GIF Type : ',3,2);
wfasttext('Horizontal : ',4,2);
wfasttext('Vertical : ',5,2);
wfasttext('No. of colors : ',6,2);
s:='';
FOR i:=1 TO 3 DO
s:=s+buf.giftype[i];
wFastWrite(s,3,23,cfg.color[3].highlightcolor);
wFastWrite(LongIntForm('########',buf.horizontal),4,18,cfg.color[3].highlightcolor);
wFastWrite(LongIntForm('########',buf.Vertical),5,18,cfg.color[3].highlightcolor);
wFastWrite(LongIntForm('########',Colors),6,18,cfg.color[3].highlightcolor);
END;
REPEAT
UNTIL GotESC;
KillWindow(Temp);
END;
PROCEDURE RunArcShell;
VAR
OldTopic,
OldTop, i,
MaxLine,
Line, Top,
InKey : WORD;
TmpArc : ArcFilePtr;
KeyWin : WindowPtr;
ExtractPath : PathStr;
PROCEDURE WriteArcLine(A:ArcFilePtr; y:BYTE; Current:BOOLEAN);
VAR
Attr:Byte;
BEGIN
WITH A^ DO
BEGIN
Attr:=CorrectAttribute(3,Current,A^.Mark);
HelpWin^.wfastWrite(CPad(CPad(FileName,13)+LongIntForm('#########',OldSize)+
LongIntForm('#########',NewSize)+' '+CPad(Typ,12)+
tochar(Dt.Day)+'/'+tochar(Dt.Month)+'-'+Long2Str(Dt.Year)+' '+
tochar(Dt.Hour)+':'+tochar(Dt.Min)+':'+tochar(Dt.Sec),78),y,1,attr);
END;
END;
PROCEDURE ShowFiles(Num:WORD);
VAR
i:WORD;
BEGIN
HelpWin^.Clear;
TmpArc:=Arc;
i:=0;
WHILE (TmpArc<>NIL) AND (i<Num) DO
BEGIN
INC(i);
TmpArc:=TmpArc^.Next;
END;
i:=0;
WHILE (i<HelpWin^.Height) AND (TmpArc<>NIL) DO
BEGIN
INC(i);
WriteArcLine(TmpArc,i,False);
TmpArc:=TmpArc^.Next;
END;
MaxLine:=i;
IF Line>MaxLine THEN Line:=MaxLine;
END;
PROCEDURE DisposeFiles;
BEGIN
WHILE Arc<>NIL DO
BEGIN
TmpArc:=Arc;
Arc:=Arc^.Next;
Dispose(TmpArc);
END;
END;
FUNCTION PtrNum(Num:WORD):ArcFilePtr;
VAR
p:ArcFilePtr;
i:WORD;
BEGIN
p:=Arc;
FOR i:=2 TO Num DO
IF P<>NIL THEN p:=p^.Next;
PtrNum:=p;
END;
FUNCTION FindNum(Want:ArcFilePtr):WORD;
VAR
p:ArcFilePtr;
i:WORD;
BEGIN
IF Arc=NIL THEN i:=0 ELSE
BEGIN
p:=Arc;
i:=1;
WHILE (p<>NIL) AND (p<>Want) DO
BEGIN
p:=p^.Next;
INC(i);
END;
IF p<>Want THEN i:=0;
END;
FindNum:=i;
END;
PROCEDURE GoDown;
BEGIN
IF Line<MaxLine THEN INC(Line) ELSE
BEGIN
IF Top+Line<TotalArc.Files THEN
BEGIN
INC(Top);
HelpWin^.ScrollVert(1);
WriteArcLine(PtrNum(Line+Top),HelpWin^.Height,False);
END;
END;
END;
FUNCTION MarkCount:WORD;
VAR
i:WORD;
BEGIN
i:=0;
TmpArc:=Arc;
WHILE TmpArc<>NIL DO
BEGIN
IF TmpArc^.Mark THEN INC(i);
TmpArc:=TmpArc^.Next;
END;
MarkCount:=i;
END;
PROCEDURE RemoveFromList(p:ArcFilePtr);
VAR
TmpArc,TmpArc2:ArcFilePtr;
i:WORD;
BEGIN
IF p=Arc THEN
BEGIN
TmpArc:=Arc;
Arc:=Arc^.Next;
Dispose(TmpArc);
DEC(TotalArc.Files);
END ELSE
BEGIN
i:=FindNum(p);
IF i>0 THEN
BEGIN
TmpArc:=PtrNum(i-1);
TmpArc2:=PtrNum(i+1);
TmpArc^.Next:=TmpArc2;
Dispose(p);
DEC(TotalArc.Files);
END;
END;
END;
PROCEDURE UnMarkAll;
BEGIN
TmpArc:=Arc;
WHILE TmpArc<>NIL DO
BEGIN
TmpArc^.Mark:=False;
TmpArc:=TmpArc^.Next;
END;
ShowFiles(Top);
END;
PROCEDURE DeleteFiles;
VAR
b,MarkedOne:BOOLEAN;
s:STRING;
BEGIN
IF MarkCount=0 THEN
BEGIN
MarkedOne:=True;
TmpArc:=PtrNum(Top+Line);
TmpArc^.Mark:=True;
END ELSE
MarkedOne:=False;
IF MarkedOne THEN b:=Confirm('Delete current file','N',8)
ELSE b:=Confirm('Delete marked file(s)','N',8);
IF b THEN
BEGIN
TmpArc:=Arc;
WHILE TmpArc<>NIL DO
BEGIN
s:='';
WHILE (TmpArc<>NIL) AND (LENGTH(s)<60) DO
BEGIN
IF TmpArc^.Mark THEN
BEGIN
IF s<>'' THEN s:=s+' ';
s:=s+TmpArc^.FileName;
RemoveFromList(TmpArc);
TmpArc:=Arc;
END
ELSE TmpArc:=TmpArc^.Next;
END;
IF s<>'' THEN
BEGIN
ArcCommand(ArcType,3,FNam,s);
END;
END;
END;
IF MarkedOne THEN UnMarkAll;
ShowFiles(Top);
END;
PROCEDURE TestArchive;
BEGIN
IF Confirm('Test archive','Y',8) THEN
BEGIN
IF ArcCommand(ArcType,4,FNam,'') THEN
UserInformation(8,'Archive seems to be intact',4,2000)
ELSE
UserInformation(8,'Archive seems to be damaged',4,2001);
END;
END;
PROCEDURE ExtractFiles;
VAR
s : STRING;
OldDir : PathStr;
MarkedOne: BOOLEAN;
BEGIN
GetDir(0,OldDir);
IF SelectPath(ExtractPath) THEN
BEGIN
IF MarkCount=0 THEN
BEGIN
MarkedOne:=True;
TmpArc:=PtrNum(Top+Line);
TmpArc^.Mark:=True;
END
ELSE MarkedOne:=False;
ChangeDir(ExtractPath);
TmpArc:=Arc;
WHILE TmpArc<>NIL DO
BEGIN
s:='';
WHILE (TmpArc<>NIL) AND (LENGTH(s)<60) DO
BEGIN
IF TmpArc^.Mark THEN
BEGIN
IF s<>'' THEN s:=s+' ';
s:=s+TmpArc^.FileName;
END;
TmpArc:=TmpArc^.Next;
END;
IF s<>'' THEN ArcCommand(ArcType,2,FNam,s);
END;
ChangeDir(OldDir);
IF MarkedOne THEN UnMarkAll;
END;
END;
BEGIN
MyWin(KeyWin,1,ScreenHeight-1,80,ScreenHeight,3,'',False);
WITH KeyWin^ DO
BEGIN
wFastText('F1=Help F2=Delete F3=Test F4=Extract',1,1);
END;
OldTopic:=Topic;
Topic:=62;
ExtractPath:=StartPath;
Line:=1;
Top:=0;
HelpWin^.Select;
ShowFiles(Top);
REPEAT
WriteArcLine(PtrNum(Line+Top),Line,True);
InKey:=PoPReadKeyWord;
WriteArcLine(PtrNum(Line+Top),Line,False);
CASE InKey OF
Home : BEGIN
OldTop:=Top;
Top:=0;
Line:=1;
IF OldTop<>Top THEN ShowFiles(Top);
END;
Up : IF Line>1 THEN DEC(Line) ELSE
BEGIN
IF Top>0 THEN
BEGIN
DEC(Top);
HelpWin^.ScrollVert(-1);
WriteArcLine(PtrNum(Line+Top),1,False);
END;
END;
PgUp : BEGIN
OldTop:=Top;
i:=HelpWin^.Height-1;
REPEAT
DEC(i);
IF Line>1 THEN DEC(Line) ELSE
IF Top>0 THEN DEC(Top);
UNTIL i=0;
IF OldTop<>Top THEN ShowFiles(Top);
END;
Down : GoDown;
PgDn : BEGIN
OldTop:=Top;
i:=HelpWin^.Height-1;
REPEAT
DEC(i);
IF (Line<HelpWin^.Height) THEN
BEGIN
IF Line<TotalArc.Files-Top THEN INC(Line);
END
ELSE
IF Top<TotalArc.Files-HelpWin^.Height THEN INC(Top);
UNTIL i=0;
IF OldTop<>Top THEN ShowFiles(Top);
END;
EndKey : BEGIN
IF TotalArc.Files>HelpWin^.Height THEN
BEGIN
OldTop:=Top;
Top:=TotalArc.Files-HelpWin^.Height;
IF OldTop<>Top THEN ShowFiles(Top);
Line:=MaxLine;
END ELSE
BEGIN
Top:=0;
Line:=MaxLine;
END;
END;
Enter : BEGIN
TmpArc:=PtrNum(Top+Line);
TmpArc^.Mark:=NOT TmpArc^.Mark;
WriteArcLine(TmpArc,Line,False);
GoDown;
END;
Space : UnMarkAll;
F2 : DeleteFiles;
F3 : TestArchive;
F4 : ExtractFiles;
END;
UNTIL InKey=Esc;
DisposeFiles;
KillWindow(KeyWin);
Topic:=OldTopic;
END;
BEGIN
{$IFNDEF PoPLite}
Arc:=NIL;
IF (ArcType<>0) AND (ArcType<>127) THEN
BEGIN
MyWin(ArcViewWin,1,2,80,ScreenHeight-3,3,'Viewing archive: '+JustFileName(FNam),False);
ArcViewWin^.wfastwrite('File Name File Size Size Now Method File Date & Time ' +
charstr(' ',13),1,1,cfg.color[3].blockcolor);
MyWin(HelpWin,2,4,79,ScreenHeight-4,3,'',False);
FillChar(TotalArc,SizeOf(TotalArc),#0);
END;
Error:=False;
IF ArcType<>127 THEN New(Wait, Init(8, 2,'Reading archive contents'));
CASE ArcType OF
-2,2 : ViewZIP(FNam, SelfExtractingOffset, Wait);
-3,3 : ViewLZH(FNam, SelfExtractingOffset, Wait);
-1,-4,1,4 : ViewARC(FNam, SelfExtractingOffset, Wait);
-6,6 : ViewSQZ(FNam, SelfExtractingOffset, Wait);
7,-7 : ViewARJ(FNam, SelfExtractingOffset, Wait);
127 : DisplayGIFInfo(FNam);
END;
IF ArcType<>127 THEN Dispose(Wait, Done);
IF Error THEN
BEGIN
AskError(8,'Not enough memory to display archive',4);
END ELSE
BEGIN
IF (ArcType<>0) AND (ArcType<>127) THEN
BEGIN
RunArcShell;
KillWindow(ArcViewWin);
KillWindow(HelpWin);
END;
END;
{$ELSE}
AskError(10, 'Not implemented in Portal of Power/Lite', 2);
{$ENDIF}
END;
END.